home *** CD-ROM | disk | FTP | other *** search
/ SAT1: Planix Home / PLANIX HOME.iso / program / radk / lexware.in_ / lexware.bin
Encoding:
Text File  |  1995-06-30  |  9.1 KB  |  282 lines
  1. '*===========================================================================
  2. '*    Lexware.inc
  3. '*    Version fuer Standard Infoware
  4. '*    Datum: 30.05.1994
  5. '*===========================================================================
  6. '*   Bitmaps
  7. '*===========================================================================
  8. CONST BMP_STD_INFOWARE      = 100
  9. '*===========================================================================
  10. ''Fenstereinstellung
  11. '*===========================================================================
  12. CONST SW_SHOWMAXIMIZED = 3
  13. '*===========================================================================
  14. ''Codierungs String
  15. '*===========================================================================
  16. GLOBAL  BSW_UC_STRING$
  17. BSW_UC_STRING = "1234098765"
  18. '*===========================================================================
  19. '* Library
  20. '*===========================================================================
  21. GLOBAL  hLibTb1%
  22. GLOBAL  hLibTb5%
  23. GLOBAL  hLib3d%
  24. GLOBAL  hInst%
  25.  
  26.  
  27. DECLARE FUNCTION LoadLibrary LIB "kernel" ( szNameDll$ ) AS INTEGER
  28. DECLARE FUNCTION ShowWindow LIB "user" (hwnd, Show% ) AS INTEGER
  29. DECLARE SUB FreeLibrary LIB "kernel" ( hLib% )
  30.  
  31. '' 3D-Dialoge
  32. DECLARE FUNCTION GetModuleHandle LIB "kernel" ( szName$ ) AS INTEGER
  33. DECLARE FUNCTION Ctl3dAutoSubclass LIB "ctl3d.dll" ( hInst% ) AS INTEGER
  34. DECLARE FUNCTION Ctl3dRegister LIB "ctl3d.dll" ( hInst% ) AS INTEGER
  35. DECLARE FUNCTION Ctl3dUnregister LIB "ctl3d.dll" ( hInst% ) AS INTEGER
  36.  
  37. DECLARE Function LexReverse (szString$) As String
  38. DECLARE Function LexUserDeCode (szString$) As String
  39. DECLARE Function LexUserEnCode (szString$) As String
  40. DECLARE Function LexUserMakeCRC (szCheck$) As String
  41. DECLARE FUNCTION LexMakePath (szDir$, szFile$) AS STRING
  42. DECLARE FUNCTION LexProgman (rc%) AS INTEGER
  43.  
  44. DECLARE FUNCTION LexInit ( rc% ) AS INTEGER
  45. DECLARE FUNCTION LexExit ( rc%) AS INTEGER
  46.  
  47.  
  48. ''===================================================================
  49. ''Funktionsname : LexInit
  50. ''===================================================================
  51. ''Beschreibung: 3D Dialog
  52. ''              Laden der Library
  53. ''              Bitmap laden
  54. ''              Vollbild
  55. ''===================================================================
  56. FUNCTION LexInit (rc% ) STATIC AS INTEGER
  57. Dim Ret As Integer
  58. Ret = 0                 '' alles in Ordnung
  59.     hLib3d% = LoadLibrary( "ctl3d.dll" )
  60.     IF hLib3d% < 33  THEN
  61.           i% = DoMsgBox("Library 'CTL3D.DLL' wurde nicht ordnungsgemΣ▀ geladen.", "Installationsfehler", MB_TASKMODAL+MB_ICONHAND+MB_OK)
  62.           hLib3d%= 0
  63.           Ret = 1
  64.           GOTO Fehler
  65.     END IF
  66.  
  67.     hLibTb1% = LoadLibrary( "tbpro1w.dll" )
  68.     IF hLibTb1% < 33  THEN
  69.         i% = DoMsgBox("Library 'tbpro1w.dll' wurde nicht ordnungsgemΣ▀ geladen.", "Installationsfehlerr", MB_TASKMODAL+MB_ICONHAND+MB_OK)
  70.         hLibTb1% = 0
  71.         FreeLibrary( hLib3d% )
  72.         Ret = 1
  73.         GOTO Fehler
  74.     END IF
  75.  
  76.     hLibTb5% = LoadLibrary( "tbpro5w.dll" )
  77.     IF hLibTb5% < 33  THEN
  78.         i% = DoMsgBox("Library 'tbpro5w.dll' wurde nicht ordnungsgemΣ▀ geladen.", "Installationsfehlerr", MB_TASKMODAL+MB_ICONHAND+MB_OK)
  79.         hLibTb5% = 0
  80.         FreeLibrary( hLib3d% )
  81.         FreeLibrary( hLibTb1% )
  82.         Ret = 1
  83.         GOTO Fehler
  84.    END IF
  85.  
  86. '' 3D-Dialoge
  87.     hInst% = GetModuleHandle( "setup.exe" )
  88.     tmp1% = Ctl3dRegister( hInst% )
  89.     tmp2% = Ctl3dAutoSubclass( hInst% )
  90.  
  91.    SetBitmap "mscuistf.dll", BMP_STD_INFOWARE
  92.    i% = ShowWindow(HwndFrame(),SW_SHOWMAXIMIZED)
  93.  
  94. Fehler:
  95.     LexInit= Ret
  96.  
  97. END FUNCTION
  98. ''===========================================================================
  99. ''Funktionsname :  LexExit
  100. ''===========================================================================
  101. ''Beschreibung:
  102. ''              Speicher frei geben von den Library┤s
  103. ''===========================================================================
  104. FUNCTION LexExit( rc% ) STATIC AS INTEGER
  105.     FreeLibrary( hLibTb1% )
  106.     FreeLibrary( hLibTb5% )
  107.     FreeLibrary( hLib3d% )
  108.     tmp1% = Ctl3dUnRegister( hInst% )
  109. END FUNCTION
  110.  
  111. ''==================================================================
  112. ''Funktionsname : LexMakePath
  113. ''---------------------------------------------------------------------------
  114. '' Beschreibung :
  115. ''      Erzeugt ein kompletten Dateiname aus Verzeichnis und Dateinamen.
  116. ''      Wenn erforderlich, dann wird an das Verzeichnis ein '\' angehaengt.
  117. ''===========================================================================
  118. FUNCTION LexMakePath (szDir$, szFile$) STATIC AS STRING
  119.     IF szDir$ = "" THEN
  120.        LexMakePath = szFile$
  121.     ELSEIF szFile$ = "" THEN
  122.        LexMakePath = szDir$
  123.     ELSEIF MID$(szDir$, LEN(szDir$), 1) = "\" THEN
  124.        LexMakePath = szDir$ + szFile$
  125.     ELSE
  126.        LexMakePath = szDir$ + "\" + szFile$
  127.     END IF
  128. END FUNCTION
  129. ''=======================================================================================
  130. ''Funktinosname: LexReverse
  131. ''===========================================================================
  132. ''Beschreibung:
  133. ''              der String wird ungekehrt   fⁿr die Kodierung
  134. ''===========================================================================
  135. FUNCTION  LexReverse (szString$) STATIC AS String
  136.   Dim Tmp As String
  137.   Dim i As Integer
  138.  
  139.   Tmp = ""
  140.  
  141.   For i = 1 To Len(RTRIM$(szString$))
  142.     Tmp = Mid$(szString$, i, 1) + Tmp
  143.   Next i
  144.  
  145.   LexReverse = Tmp
  146. END FUNCTION
  147. ''=======================================================================================
  148. ''Funktinosname: LexUserDeCode
  149. ''===========================================================================
  150. ''Beschreibung:
  151. ''               Dekodiert den in szString ⁿbergebenen String
  152. ''=======================================================================================
  153. FUNCTION  LexUserDeCode (szString$) STATIC As String
  154.  
  155.   Dim Ret As String
  156.   Dim Tmp As String
  157.   Dim cnt As Integer
  158.   Dim i As Integer
  159.   Dim Source As Integer
  160.   Dim OffSet As Integer
  161.   Dim laenge As Integer
  162.  
  163.   Tmp = ""
  164.  
  165.   ' erst dekodieren
  166.   cnt = 1
  167.   For i = 1 To Len(RTRIM$(szString$))
  168.     '
  169.     Source = Asc(Mid$(szString$, i, 1))
  170.     OffSet = Val(Mid$(BSW_UC_STRING, cnt, 1))
  171.  
  172.     If Source = 250 Then
  173.       i = i + 1
  174.       Source = Asc(Mid$(szString$, i, 1))
  175.       Tmp = Tmp + Chr$(Source + OffSet)
  176.     Else
  177.       Tmp = Tmp + Chr$(Source - OffSet)
  178.     End If
  179.  
  180.     ' # UC_STRING Weiterschalten
  181.     cnt = cnt + 1
  182.     laenge = Len( BSW_UC_STRING )
  183.     If ( cnt > laenge ) Then
  184.        cnt = 1
  185.     END IF
  186.   Next i
  187.  
  188. ''**  jetzt noch umdrehen
  189.   Ret = LexReverse(Tmp)
  190.  
  191. ' # Zuweisung und Rⁿckgabe
  192.   LexUserDeCode = Ret
  193. END FUNCTION
  194. ''=======================================================================================
  195. ''Funktinosname: LexUserEnCode
  196. ''===========================================================================
  197. ''Beschreibung:
  198. ''              Kodiert den in szString ⁿbergebenen String
  199. ''=======================================================================================
  200. FUNCTION LexUserEnCode (szString$) STATIC As String
  201.  
  202.   Dim Ret As String
  203.   Dim Tmp As String
  204.   Dim i As Integer
  205.   Dim cnt As Integer
  206.   '
  207.   Dim Source As Integer
  208.   Dim OffSet As Integer
  209.   Dim laenge As Integer
  210.  
  211.   Ret = ""
  212.  
  213.   ' # erst mal umdrehen
  214.   Tmp = LexReverse(szString$)
  215.  
  216.   ' jetzt kodieren
  217.   cnt = 1
  218.   For i = 1 To Len(RTRIM$(Tmp))
  219.     '
  220.     Source = Asc(Mid$(Tmp, i, 1))
  221.     OffSet = Val(Mid$(BSW_UC_STRING, cnt, 1))
  222.     ' bitte kein ▄berlauf
  223.     If Source > 240 Then
  224.       Ret = Ret + Chr$(250) + Chr$(Source - OffSet)
  225.     Else
  226.       Ret = Ret + Chr$(Source + OffSet)
  227.     End If
  228.     ' # UC_STRING Weiterschalten
  229.     cnt = cnt + 1
  230.     laenge = Len( BSW_UC_STRING )
  231.     If cnt > laenge Then
  232.         cnt = 1
  233.     End If
  234.   Next i
  235.  
  236.   LexUserEnCode = Ret
  237. END FUNCTION
  238. ''=======================================================================================
  239. ''Funktinosname: LexUserMakeCRC
  240. ''===========================================================================
  241. ''Beschreibung:
  242. ''              Generiert eine Checksumme aus dem kodierten String
  243. ''=======================================================================================
  244. FUNCTION  LexUserMakeCRC (szCheck$) STATIC As String
  245.  
  246.   Dim i As Integer
  247.   Dim crc As Long
  248.  
  249.   crc = 0
  250.   For i = 1 To Len(RTRIM$(szCheck$))
  251.     crc = crc + Asc(Mid$(szCheck$, i, 1))
  252.   Next i
  253.   LexUserMakeCRC = LexReverse(Hex$(crc))
  254. END FUNCTION
  255. ''=======================================================================================
  256. ''Funktinosname: LexSystemShellRead
  257. ''===========================================================================
  258. ''Beschreibung:
  259. ''              System.ini prⁿfen auf Shell ndw.exe
  260. ''              fⁿr Norten Desktop Anwendungen
  261. '*===========================================================================
  262. FUNCTION LexProgman(rc%) STATIC AS Integer
  263.   Dim Ret    As Integer
  264.   Dim Tmp    As String
  265.   Dim i      As Integer
  266.   Dim Source As String
  267.  
  268.   Ret = 0
  269.    if GetModuleHandle("progman.exe") = 0 THEN
  270.       Ret = RUN ("progman.exe")
  271.    END IF
  272.   LexProgman = Ret
  273. END FUNCTION
  274.  
  275.  
  276.  
  277.  
  278.  
  279.  
  280.  
  281.  
  282.